;;;
;;; JaCoLiB
;;; Copyright (C) 2008 Alessandro Serra
;;; 
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;; 
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;; 
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;;

;;;; 2008-06-27 20:53:16

(in-package :jacolib)

;
; Json Serializer
;
 
(defstruct json-serializer
  (objecttype2serializer (make-hash-table :test 'equal))            
  (objecttype2deserializer (make-hash-table :test 'equal)))

; global vars

(defvar *json-serializer* (make-json-serializer))

; encode/decode functions

(defun json-serializer-encode (obj stream)
  (json:encode-json obj stream))

(defun json-serializer-encode-to-string (obj)
  (with-output-to-string (stream)
                         (json-serializer-encode obj stream)))

(defun json-serializer-decode (stream)
  (json:decode-json stream))

(defun json-serializer-decode-from-string (str)
  (with-input-from-string (stream str)
                          (json-serializer-decode stream)))

; register functions

(defun json-serializer-serializer-register (typename serializer)
  (setf (gethash typename 
                 (json-serializer-objecttype2serializer *json-serializer*))
        serializer))

(defun json-serializer-deserializer-register (typename deserializer)
  (setf (gethash typename 
                 (json-serializer-objecttype2deserializer *json-serializer*))
        deserializer))

; call functins 

(defun json-serializer-deserializer-call (typename alist)
  (let ((deser 
	 (gethash typename 
		  (json-serializer-objecttype2deserializer *json-serializer*))))
    (if deser
        (funcall deser alist)
          (error 'protocol-error 
                 :message (format nil "Deserialization error. Unknow object type: ~A" typename)))))

(defun json-serializer-serializer-call (typename obj)
  (let ((ser 
	 (gethash typename 
		  (json-serializer-objecttype2serializer *json-serializer*))))
    (if (not ser)
        (progn
          (setf ser
                (gethash 'unknow-object 
                         (json-serializer-objecttype2serializer *json-serializer*)))
          (setf obj (make-unknow-object :typename (type-of obj) :value-as-string (format nil "~A" obj)))))
    (funcall ser obj)))

; def serializer/deserializer macros

(defmacro def-json-serializer (type typename &rest body)
  `(json-serializer-serializer-register ,type
			  #'(lambda (obj)
			      (let ((alist nil))
			        (labels ((aadd (el val)
			                   (push (cons el val) alist)))
			          ;(format t "serializing: ~A (~A)~%" obj (type-of obj))
			          (aadd "type" ,typename)
			          ,@body
			          ;(format t "serialized into ~A~%" alist)
			          alist
			          )))))

(defmacro def-json-deserializer (typename &rest body)
  `(json-serializer-deserializer-register ,typename
			  #'(lambda (alist)
			      (let ((obj nil))
			        (labels ((afind (el typ)
			                   (let ((v (assoc el alist :test 'equal)))
			                     (if v 
			                         (progn 
			                           (if (not (typep (cdr v) typ))
			                               (error 'protocol-error 
			                                :message (format nil "Wrong type for the attribute ~A in the alist ~A. Expected ~A. " el alist typ)))
			                           (cdr v))
			                         nil))))
			                         ;(error 'protocol-error 
			                         ;       :message (format nil "Expected ~A attribute into the alist ~A" el alist))))))
			          ;(format t "deserializing: ~A (~A)~%" alist ,typename)
			          ,@body
			          ;(format t "deserialized into ~A~%" obj)
			          obj)))))

(defmacro def-json-serializer-and-deserializer (typename s-body d-body)
  `(progn
    (def-serializer ,typename ,@s-body)
    (def-deserializer ,typename ,@d-body)))
   
; json methods

(defmethod json:encode-json (obj stream)
  (let ((typename (type-of obj)))
    (json:encode-json-alist (json-serializer-serializer-call typename obj) stream)))

; decode

(defun alist->object (alist)
  ;(format t "alist->object calling: ~A ~%" alist)
  (let ((typename (assoc "type" alist :test 'equal)))
    (if typename
        (setf typename (cdr typename))
        (setf typename "object.json"))
    (json-serializer-deserializer-call typename alist)))

; json hooks

(setf json:*json-object-factory-return* #'alist->object )
(setf json:*json-object-factory-add-key-value* #'(lambda (obj key val) (push (cons key val) obj)))


;
; unknow object
;

(defstruct unknow-object
  (typename nil)
  (value-as-string nil))

; serializer/deserializer object.unknow

(def-json-serializer 'unknow-object "object.unkown" 
  (progn
    (aadd "typename" (format nil "~A" (unknow-object-typename obj)))
    (aadd "value-as-string" (format nil "~A" (unknow-object-value-as-string obj)))))
  
(def-json-deserializer "object.unkown" 
  (let* ((v0 (afind "typename" 'string))
         (v1 (afind "value-as-string" 'string)))
    (setf obj (make-unknow-object :typename v0 :value-as-string v1))))

;
; Json Object
;

(defstruct json-object
  (members nil))

(json-serializer-deserializer-register "object.json" 
                                       #'(lambda(alist)
                                           (make-json-object :members alist)))

(json-serializer-serializer-register 'json-object
			  #'(lambda (obj)
			      (json-object-members obj)))
